home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / transpar / transgrp.pas next >
Pascal/Delphi Source File  |  1996-04-08  |  4KB  |  172 lines
  1. { THIS IS THE OTHER ONE I WROTE AFTER THE TRANSPARENT RADIO 
  2.   BUTTON. IT IS A TRANSPARENT GROUP COMPONENT.
  3.  
  4.   Sgt Galen Smallen
  5.   EIelson AFBm, AK
  6. }
  7.  
  8. unit TransGrp;
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Menus, StdCtrls;
  15.  
  16. type
  17.   TTransGroup = class(TCustomGroupBox)
  18.   private
  19.     { Private declarations }
  20.     function GetTransparent: Boolean;
  21.     Procedure SetTransparent(Value: Boolean);
  22.   protected
  23.     { Protected declarations }
  24.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  25.     procedure paint; override;
  26.   public
  27.     { Public declarations }
  28.     constructor Create(AOwner: TComponent); override;
  29.     destructor Destroy; override;
  30.     procedure CreateParams(var Params: TCreateParams); override;
  31.     { just in case someone wants to draw on us }
  32.     property Canvas;
  33.  
  34.   published
  35.     { Published declarations }
  36.     property Align;
  37.     property Caption;
  38.     property Ctl3D;
  39.     Property Cursor;
  40.     property Color;
  41.     property DragCursor;
  42.     property DragMode;
  43.     property Enabled;
  44.     property Font;
  45.     property Height default 100;
  46.     Property HelpContext;
  47.     property Hint;
  48.     property left;
  49.     property ParentColor;
  50.     property ParentCtl3D;
  51.     property ParentFont;
  52.     property ParentShowHint;
  53.     property PopupMenu;
  54.     property ShowHint;
  55.     property TabOrder;
  56.     property TabStop;
  57.     property Transparentcy: Boolean Read GetTransparent Write SetTransParent default True;
  58.     property Visible;
  59.     property Width default 100;
  60.  
  61.     property OnClick;
  62.     property OnDblClick;
  63.     property OnMouseDown;
  64.     property OnMouseMove;
  65.     property OnMouseUp;
  66.     property OnKeyDown;
  67.   end;
  68.  
  69. procedure Register;
  70.  
  71. implementation
  72.  
  73. procedure Register;
  74. begin
  75.   RegisterComponents('NewTools', [TTransGroup]);
  76. end;
  77.  
  78. constructor TTransGroup.Create(AOwner: TComponent);
  79. begin
  80.      { call mom }
  81.      inherited Create(AOwner);
  82.      { initialize and create some of our properties }
  83.      Width := 100; Height := 100;
  84. end;
  85.  
  86. destructor TTransGroup.Destroy;
  87. begin
  88.      { destroy the properties that we created }
  89.      { nothing in this case }
  90.  
  91.      { call gozer }
  92.      inherited Destroy;
  93. end;
  94.  
  95. procedure TTransGroup.CreateParams(var Params: TCreateParams);
  96. begin
  97.      { call the create of the params }
  98.      inherited CreateParams(Params);
  99.  
  100.      { and then add our twist, transparency }
  101.      if Transparentcy then
  102.           Params.ExStyle := Params.ExStyle + WS_EX_Transparent;
  103. end;
  104.  
  105. procedure TTransGroup.Paint;
  106. var
  107.   H: Integer;
  108.   R: TRect;
  109.   C: array [Byte] of Char;
  110.   CLen: Integer;
  111. begin
  112.   with Canvas do
  113.   begin
  114.     Font := Self.Font;
  115.     H := TextHeight('0');
  116.     R := Rect(0, H, Width, Height);
  117.     if Ctl3D then
  118.     begin
  119.       Inc(R.Left);
  120.       Inc(R.Top);
  121.       Brush.Color := clBtnHighlight;
  122.       FrameRect(R);
  123.       OffsetRect(R, -1, -1);
  124.       Brush.Color := clBtnShadow;
  125.     end else
  126.       Brush.Color := clWindowFrame;
  127.  
  128.     FrameRect(R);
  129.     StrPCopy(C, Text);
  130.     if C[0] <> #0 then
  131.     begin
  132.       StrPCopy(C, Text);
  133.       CLen := StrLen(C);
  134.       R := Rect(1, 0, 0, H);
  135.       DrawText(Handle, C, CLen, R, DT_LEFT or DT_SINGLELINE or DT_CALCRECT);
  136.       if Transparentcy then
  137.       begin
  138.       SetBkMode(Handle,TRANSPARENT);
  139.       SetBkColor(Handle,Color);
  140.       end;
  141.       SetTextColor(Handle,Font.Color);
  142.       DrawText(Handle, C, CLen, R, DT_LEFT or DT_SINGLELINE);
  143.      end;
  144.   end;
  145.       end;
  146.  
  147.  
  148.   procedure TTransGroup.AlignControls(AControl: TControl; var Rect: TRect);
  149.   begin
  150.        inherited AlignControls(Acontrol,Rect);
  151.   end;
  152.  
  153.  function TTransGroup.GetTransparent: Boolean;
  154. begin
  155.   Result := not (csOpaque in ControlStyle);
  156. end;
  157.  
  158. procedure TTransGroup.SetTransparent(Value: Boolean);
  159. begin
  160.   if Transparentcy <> Value then
  161.   begin
  162.     if Value then
  163.       ControlStyle := ControlStyle - [csOpaque] else
  164.       ControlStyle := ControlStyle + [csOpaque];
  165.     Invalidate;
  166.   end;
  167. end;
  168.  
  169.  
  170. end.
  171.  
  172.